ProcessMonitor.st
author Claus Gittinger <cg@exept.de>
Mon, 23 Oct 1995 21:08:26 +0100
changeset 144 31afc0d87819
parent 143 95c177bc7678
child 165 df29ee4514c1
permissions -rw-r--r--
.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
     1
"
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
     2
 COPYRIGHT (c) 1993 by Claus Gittinger
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
     3
	      All Rights Reserved
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
     4
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
     5
 This software is furnished under a license and may be used
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
     6
 only in accordance with the terms of that license and with the
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
     8
 be provided or otherwise made available to, or used by, any
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
     9
 other person.  No title to or ownership of the software is
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    10
 hereby transferred.
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    11
"
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    12
143
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
    13
'From Smalltalk/X, Version:2.10.7 on 29-sep-1995 at 02:24:01'                   !
85
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
    14
93
claus
parents: 92
diff changeset
    15
SimpleView subclass:#ProcessMonitor
85
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
    16
	 instanceVariableNames:'listView processes listUpdateDelay updateDelay updateBlock
144
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
    17
		listUpdateBlock updateProcess hideDead runColor suspendedColor
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
    18
		waitColor cpuUsages showDetail'
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
    19
	 classVariableNames:''
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
    20
	 poolDictionaries:''
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
    21
	 category:'Interface-Tools'
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
    22
!
4cde336c0794 Initial revision
claus
parents:
diff changeset
    23
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    24
!ProcessMonitor class methodsFor:'documentation'!
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    25
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    26
copyright
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    27
"
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    28
 COPYRIGHT (c) 1993 by Claus Gittinger
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    29
	      All Rights Reserved
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    30
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    31
 This software is furnished under a license and may be used
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    32
 only in accordance with the terms of that license and with the
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    33
 inclusion of the above copyright notice.   This software may not
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    34
 be provided or otherwise made available to, or used by, any
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    35
 other person.  No title to or ownership of the software is
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    36
 hereby transferred.
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    37
"
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    38
!
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    39
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    40
version
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    41
"
144
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
    42
$Header: /cvs/stx/stx/libtool/ProcessMonitor.st,v 1.23 1995-10-23 20:08:21 cg Exp $
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    43
"
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    44
!
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    45
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    46
documentation
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    47
"
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    48
    This view shows smalltalks (light-weight) processes, and also offers
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    49
    a popup menu for various useful operations on them.
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    50
    Especially 'debug' is useful, to see what a process is currently
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    51
    doing.
85
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
    52
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    53
    The information shown is:
90
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
    54
	id         - the numeric id of the process
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
    55
	name       - the name (if any) of the process
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
    56
		     (the name has no semantic meaning; it exists for the processMonitor only)
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
    57
	state      - what is it doing;
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
    58
			wait      - waiting on a semaphore
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
    59
			eventWait - waiting on a view-event semaphore
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
    60
			ioWait    - waiting on an io-semaphore
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
    61
			timeWait  - waiting for a time-semaphore
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
    62
			run       - run, but currently not scheduled
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
    63
			active    - really running (this info is useless, since at
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
    64
				    update time, its always the update process which is
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
    65
				    running)
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
    66
			suspended - suspended; not waiting on a semaphore
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
    67
			light     - not yet started (i.e. has no stack yet)
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    68
        
90
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
    69
	prio       - the processes priority (1..30)
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
    70
	usedStack  - the current stack use
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
    71
	totalStack - the stack currently allocated (i.e. the maximum ever needed)
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    72
"
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    73
! !
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    74
56
d0cb937cbcaa *** empty log message ***
claus
parents: 52
diff changeset
    75
!ProcessMonitor class methodsFor:'defaults'!
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
    76
56
d0cb937cbcaa *** empty log message ***
claus
parents: 52
diff changeset
    77
defaultLabel
d0cb937cbcaa *** empty log message ***
claus
parents: 52
diff changeset
    78
    ^ 'Process Monitor'
d0cb937cbcaa *** empty log message ***
claus
parents: 52
diff changeset
    79
!
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
    80
56
d0cb937cbcaa *** empty log message ***
claus
parents: 52
diff changeset
    81
defaultIcon
d0cb937cbcaa *** empty log message ***
claus
parents: 52
diff changeset
    82
    |i|
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
    83
93
claus
parents: 92
diff changeset
    84
    i := Image fromFile:'ProcMon.xbm'.
56
d0cb937cbcaa *** empty log message ***
claus
parents: 52
diff changeset
    85
    i notNil ifTrue:[^ i].
85
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
    86
    ^ StandardSystemView defaultIcon
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
    87
! !
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
    88
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
    89
!ProcessMonitor class methodsFor:'startup'!
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
    90
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
    91
open
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
    92
    |top monitor|
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
    93
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
    94
    top := StandardSystemView new.
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
    95
    monitor := self origin:0.0@0.0 corner:1.0@1.0 in:top.
105
claus
parents: 100
diff changeset
    96
    top extent:monitor preferredExtent.
85
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
    97
    top label:self defaultLabel.
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
    98
    top icon:self defaultIcon.
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
    99
    top open
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   100
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   101
    "
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   102
     ProcessMonitor open
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   103
    "
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   104
! !
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   105
143
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   106
!ProcessMonitor methodsFor:'destroying'!
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   107
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   108
destroy
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   109
    updateBlock notNil ifTrue:[
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   110
	Processor removeTimedBlock:updateBlock.
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   111
	Processor removeTimedBlock:listUpdateBlock.
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   112
    ] ifFalse:[
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   113
	updateProcess notNil ifTrue:[updateProcess terminate]
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   114
    ].
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   115
    super destroy
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   116
! !
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   117
85
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   118
!ProcessMonitor methodsFor:'drawing'!
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   119
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   120
titleLine
109
claus
parents: 107
diff changeset
   121
    showDetail ifTrue:[
143
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   122
    ^ 'id   name                           state    prio   usedStack  totalStack   current-segment   switches   where'.
109
claus
parents: 107
diff changeset
   123
    ].
143
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   124
    ^ 'id   name                           state    prio   usedStack  where'.
85
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   125
!
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   126
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   127
updateList
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   128
    "update list of processes"
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   129
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   130
    |newList|
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   131
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   132
    shown ifTrue:[
109
claus
parents: 107
diff changeset
   133
	showDetail ifTrue:[
90
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   134
	    newList := Process allInstances.
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   135
	] ifFalse:[
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   136
	    newList := ProcessorScheduler knownProcesses asOrderedCollection.
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   137
	].
85
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   138
90
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   139
	"sort by id - take care of nil ids of dead processes"
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   140
	newList sort:[:p1 :p2 |
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   141
			 |id1 id2|
85
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   142
90
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   143
			 (p1 isNil or:[(id1 := p1 id) isNil])
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   144
			     ifTrue:[true]
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   145
			     ifFalse:[
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   146
				 (p2 isNil or:[(id2 := p2 id) isNil])
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   147
				     ifTrue:[false]
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   148
				     ifFalse:[id1 < id2]
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   149
			 ]
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   150
		     ].
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   151
	newList ~= processes ifTrue:[
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   152
	    processes := WeakArray withAll:newList.
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   153
	    self updateStatus
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   154
	].
85
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   155
    ].
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   156
    updateBlock notNil ifTrue:[
90
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   157
	Processor removeTimedBlock:listUpdateBlock.
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   158
	Processor addTimedBlock:listUpdateBlock afterSeconds:listUpdateDelay
85
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   159
    ].
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   160
!
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   161
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   162
updateStatus
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   163
    "update status display of processes"
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   164
110
claus
parents: 109
diff changeset
   165
    |oldList list line dIndex con interrupted plist|
85
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   166
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   167
    shown ifTrue:[
144
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   168
	oldList := listView list.
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   169
	processes notNil ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   170
	    list := OrderedCollection new.
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   171
	    list add:self titleLine.
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   172
	    list add:(String new:self titleLine size withAll:$-).
85
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   173
144
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   174
	    interrupted := Processor interruptedProcess.
85
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   175
144
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   176
	    dIndex := 1.
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   177
	    1 to:processes size do:[:index |
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   178
		|aProcess nm st c c0 n found|
85
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   179
144
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   180
		aProcess := processes at:index.
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   181
		aProcess notNil ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   182
		    (aProcess id notNil or:[hideDead not]) ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   183
			line := aProcess id printStringPaddedTo:5.
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   184
			(nm := aProcess name) isNil ifFalse:[
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   185
			    nm := nm printString
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   186
			] ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   187
			    nm := ' '
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   188
			].
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   189
			nm size >= 29 ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   190
			    nm := (nm contractTo:28) , ' '
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   191
			] ifFalse:[
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   192
			    nm := (nm printStringPaddedTo:29).
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   193
			].
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   194
			line := line , nm.
85
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   195
"/                        n := cpuUsages at:(aProcess id) ifAbsent:[0].
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   196
"/                        n ~~ 0 ifTrue:[
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   197
"/                            line := line , ((n * 4) printStringLeftPaddedTo:3)
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   198
"/                        ] ifFalse:[
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   199
"/                            line := line , '   '
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   200
"/                        ].
144
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   201
			st := aProcess state.
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   202
			(st == #run
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   203
			 and:[aProcess == interrupted]) ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   204
			    c := ' *'.
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   205
			] ifFalse:[
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   206
			    c := '  '.
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   207
			].
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   208
			line := line , c , (st printStringPaddedTo:9).
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   209
			line := line , (aProcess priority printStringLeftPaddedTo:3).
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   210
			line := line , (aProcess usedStackSize printStringLeftPaddedTo:11).
143
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   211
144
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   212
			n := aProcess numberOfStackSegments.
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   213
			n == 0 ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   214
			    con := nil
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   215
			] ifFalse:[
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   216
			    con := aProcess suspendedContext.
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   217
			    con isNil ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   218
				aProcess == Processor activeProcess ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   219
				    con := thisContext
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   220
				]
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   221
			    ]
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   222
			].
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   223
			showDetail ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   224
			    line := line , (aProcess totalStackSize printStringLeftPaddedTo:10).
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   225
			    line := line , '(' , n printString , ')'.
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   226
			    con notNil ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   227
				line := line , '    '.
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   228
				line := line , ((ObjectMemory addressOf:con) printStringRadix:16).
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   229
				line := line , ' .. '.
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   230
				c := con.
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   231
				[c sender notNil] whileTrue:[
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   232
				    c := c sender
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   233
				].
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   234
				line := line , ((ObjectMemory addressOf:c) printStringRadix:16).
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   235
			    ] ifFalse:[
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   236
				line := line , (String new:20)
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   237
			    ].
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   238
			    line := line , ' '.
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   239
			    line := line , (aProcess numberOfStackBoundaryHits printStringLeftPaddedTo:5).
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   240
			].
143
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   241
144
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   242
			con notNil ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   243
			    "/ search for a semaphore-wait in the top 10 contexts
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   244
			    found := false.
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   245
			    c := con.
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   246
			    1 to:10 do:[:n |
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   247
				found ifFalse:[
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   248
				    c notNil ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   249
					(c receiver isMemberOf:Semaphore) ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   250
					    c selector == #wait ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   251
						found := true.
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   252
					    ]
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   253
					].
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   254
					c := c sender.
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   255
				    ]
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   256
				]
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   257
			    ].
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   258
			    found ifFalse:[
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   259
				c := con.
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   260
				1 to:10 do:[:n |
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   261
				    found ifFalse:[
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   262
					c notNil ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   263
					    (c receiver ~~ Processor) ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   264
						found := true.
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   265
					    ] ifFalse:[
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   266
						c := c sender.
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   267
					    ]
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   268
					]
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   269
				    ]
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   270
				]
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   271
			    ].
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   272
			    found ifFalse:[
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   273
				c := con
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   274
			    ].
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   275
			    [c notNil and:[c isBlockContext]] whileTrue:[
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   276
				c := c home
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   277
			    ].
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   278
			    c notNil ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   279
				n := c receiver class name , '>>' , c selector.
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   280
				line := line , '   ' , n
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   281
			    ]
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   282
			].
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   283
			list add:line.
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   284
			processes at:dIndex put:aProcess.
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   285
			dIndex := dIndex + 1
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   286
		    ]
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   287
		].
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   288
	    ].
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   289
	    dIndex to:processes size do:[:index |
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   290
		processes at:index put:nil
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   291
	    ]
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   292
	].
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   293
	"avoid flicker"
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   294
	(oldList notNil and:[oldList size == list size]) ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   295
	    list keysAndValuesDo:[:idx :entry |
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   296
		(oldList at:idx) ~= entry ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   297
		    listView at:idx put:entry
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   298
		]
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   299
	    ]
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   300
	] ifFalse:[
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   301
	    listView setList:list.
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   302
	    "the first two entries cannot be selected"
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   303
	    listView attributeAt:1 put:#disabled.
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   304
	    listView attributeAt:2 put:#disabled.
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   305
	]
85
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   306
    ].
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   307
    updateBlock notNil ifTrue:[
144
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   308
	Processor removeTimedBlock:updateBlock.
Claus Gittinger <cg@exept.de>
parents: 143
diff changeset
   309
	Processor addTimedBlock:updateBlock afterSeconds:updateDelay
85
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   310
    ]
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   311
!
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   312
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   313
updateView
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   314
    self updateList.
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   315
    self updateStatus
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   316
! !
4cde336c0794 Initial revision
claus
parents:
diff changeset
   317
143
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   318
!ProcessMonitor methodsFor:'events'!
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   319
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   320
keyPress:key x:x y:y
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   321
    <resource: #keyboard ( #InspectIt ) >
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   322
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   323
    key == #InspectIt ifTrue:[
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   324
	^ self inspectProcess.
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   325
    ].
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   326
    ^ super keyPress:key x:x y:y
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   327
!
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   328
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   329
canHandle:key
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   330
    ^ key == #InspectIt
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   331
! !
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   332
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   333
!ProcessMonitor methodsFor:'initialization'!
4cde336c0794 Initial revision
claus
parents:
diff changeset
   334
4cde336c0794 Initial revision
claus
parents:
diff changeset
   335
initialize
107
claus
parents: 106
diff changeset
   336
    |v|
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   337
4cde336c0794 Initial revision
claus
parents:
diff changeset
   338
    super initialize.
4cde336c0794 Initial revision
claus
parents:
diff changeset
   339
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   340
    hideDead := true.
109
claus
parents: 107
diff changeset
   341
    showDetail := Smalltalk at:#SystemDebugging ifAbsent:false.
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   342
110
claus
parents: 109
diff changeset
   343
    v := HVScrollableView for:SelectionInListView miniScrollerH:true in:self.
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   344
    v origin:0.0@0.0 corner:1.0@1.0.
85
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   345
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   346
"/    self extent:(font widthOf:self titleLine) + v scrollBar width @ 100.
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   347
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   348
    listView := v scrolledView.
4cde336c0794 Initial revision
claus
parents:
diff changeset
   349
    listView font:font.
98
claus
parents: 97
diff changeset
   350
    listView menuHolder:self; menuPerformer:self; menuMessage:#processMenu. 
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   351
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   352
    listView multipleSelectOk:true.
97
claus
parents: 93
diff changeset
   353
    listView delegate:(KeyboardForwarder toView:self).
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   354
4cde336c0794 Initial revision
claus
parents:
diff changeset
   355
    updateDelay := 0.5.
4cde336c0794 Initial revision
claus
parents:
diff changeset
   356
    listUpdateDelay := 5.
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   357
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   358
    "/ true 
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   359
    ProcessorScheduler isPureEventDriven
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   360
    ifTrue:[
90
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   361
	updateBlock := [self updateStatus].
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   362
	listUpdateBlock := [self updateList].
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   363
    ].
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   364
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   365
    device hasColors ifTrue:[
90
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   366
	runColor := Color green.
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   367
	suspendedColor := Color yellow.
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   368
	waitColor := Color red.
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   369
    ] ifFalse:[
90
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   370
	runColor := suspendedColor := waitColor := Color black
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   371
    ]
4cde336c0794 Initial revision
claus
parents:
diff changeset
   372
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   373
    "
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   374
     ProcessMonitor open
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   375
    "
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   376
!
4cde336c0794 Initial revision
claus
parents:
diff changeset
   377
85
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   378
mapped
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   379
    super mapped.
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   380
    self updateStatus.
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   381
    self updateList.
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   382
!
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   383
93
claus
parents: 92
diff changeset
   384
startUpdateProcess
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   385
    updateBlock notNil ifTrue:[
90
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   386
	Processor addTimedBlock:updateBlock afterSeconds:updateDelay.
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   387
	Processor addTimedBlock:listUpdateBlock afterSeconds:listUpdateDelay.
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   388
    ] ifFalse:[
90
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   389
	updateProcess := [
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   390
	    Process terminateSignal handle:[:ex |
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   391
		updateProcess := nil
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   392
	    ] do:[
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   393
		|id cnt|
56
d0cb937cbcaa *** empty log message ***
claus
parents: 52
diff changeset
   394
90
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   395
		"
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   396
		 every 20ms, we look which process runs;
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   397
		 every half second, the status is updated.
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   398
		 every 5 seconds, the list of processes is
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   399
		 built up again
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   400
		"
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   401
		[true] whileTrue:[
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   402
		    1 to:9 do:[:i |
85
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   403
"/                        cpuUsages := IdentityDictionary new.
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   404
"/                        1 to:25 do:[:i |
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   405
"/                            (Delay forSeconds:0.02) wait.
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   406
"/                            id := Processor interruptedProcess id.
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   407
"/                            cnt := cpuUsages at:id ifAbsent:[0].
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   408
"/                            cpuUsages at:id put:cnt + 1.
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   409
"/                        ].
90
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   410
			(Delay forSeconds:0.5) wait.
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   411
			self updateStatus.
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   412
		    ].
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   413
		    (Delay forSeconds:0.5) wait.
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   414
		    self updateList.
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   415
		]
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   416
	    ]
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   417
	]  forkAt:(Processor userSchedulingPriority + 1).
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   418
	updateProcess name:'monitor [' , 
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   419
			   Processor activeProcess id printString ,
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   420
			   '] update'.
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   421
	"
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   422
	 raise my own priority
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   423
	"
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   424
	Processor activeProcess priority:(Processor userSchedulingPriority + 2)
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   425
    ].
93
claus
parents: 92
diff changeset
   426
!
claus
parents: 92
diff changeset
   427
claus
parents: 92
diff changeset
   428
realize
claus
parents: 92
diff changeset
   429
    super realize.
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   430
    waitColor := waitColor on:device.
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   431
    runColor := runColor on:device.
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   432
    suspendedColor := suspendedColor on:device.
93
claus
parents: 92
diff changeset
   433
claus
parents: 92
diff changeset
   434
    self startUpdateProcess.
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   435
! !
4cde336c0794 Initial revision
claus
parents:
diff changeset
   436
4cde336c0794 Initial revision
claus
parents:
diff changeset
   437
!ProcessMonitor methodsFor:'menu actions'!
4cde336c0794 Initial revision
claus
parents:
diff changeset
   438
85
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   439
processMenu
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   440
    |labels selectors m|
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   441
109
claus
parents: 107
diff changeset
   442
    device ctrlDown ifTrue:[
110
claus
parents: 109
diff changeset
   443
	labels := resources array:#(
109
claus
parents: 107
diff changeset
   444
			'\c detail'
claus
parents: 107
diff changeset
   445
		      ).
claus
parents: 107
diff changeset
   446
	selectors := #(
claus
parents: 107
diff changeset
   447
			detail
claus
parents: 107
diff changeset
   448
		      ).
claus
parents: 107
diff changeset
   449
    ] ifFalse:[
claus
parents: 107
diff changeset
   450
	labels := resources array:#(
claus
parents: 107
diff changeset
   451
			     'inspect' 
claus
parents: 107
diff changeset
   452
			     'debug'  
claus
parents: 107
diff changeset
   453
			     '-'  
claus
parents: 107
diff changeset
   454
			     'resume'  
claus
parents: 107
diff changeset
   455
			     'suspend'  
claus
parents: 107
diff changeset
   456
			     'stop'  
claus
parents: 107
diff changeset
   457
			     'abort'
claus
parents: 107
diff changeset
   458
			     'terminate'
claus
parents: 107
diff changeset
   459
			     '-'  
claus
parents: 107
diff changeset
   460
			     'raise prio'  
claus
parents: 107
diff changeset
   461
			     'lower prio'  
claus
parents: 107
diff changeset
   462
			    ).
claus
parents: 107
diff changeset
   463
	selectors := #(
claus
parents: 107
diff changeset
   464
			     inspectProcess  
claus
parents: 107
diff changeset
   465
			     debugProcess  
claus
parents: 107
diff changeset
   466
			     nil  
claus
parents: 107
diff changeset
   467
			     resumeProcess  
claus
parents: 107
diff changeset
   468
			     suspendProcess  
claus
parents: 107
diff changeset
   469
			     stopProcess  
claus
parents: 107
diff changeset
   470
			     abortProcess
claus
parents: 107
diff changeset
   471
			     terminateProcess
claus
parents: 107
diff changeset
   472
			     nil  
claus
parents: 107
diff changeset
   473
			     raisePrio
claus
parents: 107
diff changeset
   474
			     lowerPrio
claus
parents: 107
diff changeset
   475
			    ).
claus
parents: 107
diff changeset
   476
	updateProcess isNil ifTrue:[
claus
parents: 107
diff changeset
   477
	    labels := (resources array:#('update' '-')) , labels.
claus
parents: 107
diff changeset
   478
	    selectors := #(updateView nil) , selectors
claus
parents: 107
diff changeset
   479
	].
85
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   480
    ].
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   481
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   482
    m := PopUpMenu labels:labels
90
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   483
		   selectors:selectors.
85
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   484
109
claus
parents: 107
diff changeset
   485
    m checkToggleAt:#detail put:showDetail.
85
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   486
    ^ m
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   487
!
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   488
143
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   489
terminateProcess
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   490
    "terminate the selected process"
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   491
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   492
    self selectedProcessesSend:#terminate
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   493
!
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   494
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   495
hideDead:aBoolean
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   496
    hideDead := aBoolean
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   497
!
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   498
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   499
debugProcess
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   500
    "open a debugger on the selected process"
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   501
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   502
    self selectedProcessesDo:[:p |
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   503
       Debugger openOn:p
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   504
    ]
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   505
!
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   506
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   507
abortProcess
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   508
    "abort (raise AbortSignal in) the selected process"
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   509
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   510
    self selectedProcessesDo:[:p |
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   511
	p interruptWith:[AbortSignal raise]
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   512
    ]
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   513
!
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   514
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   515
inspectProcess
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   516
    "open an inspector on the selected process"
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   517
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   518
    self selectedProcessesSend:#inspect
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   519
!
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   520
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   521
detail
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   522
    showDetail := showDetail not.
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   523
    self updateView
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   524
!
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   525
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   526
resumeProcess
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   527
    "resume the selected process (i.e. let it run) "
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   528
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   529
    self selectedProcessesSend:#resume
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   530
!
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   531
92
claus
parents: 90
diff changeset
   532
stopProcess
claus
parents: 90
diff changeset
   533
    "stop the selected process - not even interrupts will wake it up"
claus
parents: 90
diff changeset
   534
claus
parents: 90
diff changeset
   535
    self selectedProcessesSend:#stop
claus
parents: 90
diff changeset
   536
!
claus
parents: 90
diff changeset
   537
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   538
suspendProcess
92
claus
parents: 90
diff changeset
   539
    "suspend the selected process - interrupts will let it run again"
claus
parents: 90
diff changeset
   540
58
43b7d463a7e5 *** empty log message ***
claus
parents: 57
diff changeset
   541
    self selectedProcessesSend:#suspend
85
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   542
!
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   543
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   544
raisePrio
92
claus
parents: 90
diff changeset
   545
    "raise the selected processes priority"
claus
parents: 90
diff changeset
   546
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   547
    self selectedProcessesDo:[:p |
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   548
       p priority:(p priority + 1)
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   549
    ]
85
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   550
!
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   551
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   552
lowerPrio
92
claus
parents: 90
diff changeset
   553
    "lower the selected processes priority"
claus
parents: 90
diff changeset
   554
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   555
    self selectedProcessesDo:[:p |
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   556
       p priority:(p priority - 1)
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   557
    ]
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   558
! !
4cde336c0794 Initial revision
claus
parents:
diff changeset
   559
143
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   560
!ProcessMonitor methodsFor:'private'!
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   561
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   562
selectedProcessesDo:aBlock
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   563
    |p nr sel|
85
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   564
143
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   565
    sel := listView selection.
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   566
    sel isNil ifTrue:[^ self].
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   567
    (sel isKindOf:Collection) ifTrue:[
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   568
	sel do:[:n |
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   569
	    nr := n - 2.   "for headlines"
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   570
	    nr notNil ifTrue:[
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   571
		nr > 0 ifTrue:[
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   572
		    p := processes at:nr.
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   573
		    p notNil ifTrue:[
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   574
		       aBlock value:p
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   575
		    ]
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   576
		]
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   577
	    ]
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   578
	]
85
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   579
    ] ifFalse:[
143
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   580
	nr := sel - 2.     "for headlines"
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   581
	nr notNil ifTrue:[
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   582
	    nr > 0 ifTrue:[
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   583
		p := processes at:nr.
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   584
		p notNil ifTrue:[
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   585
		   aBlock value:p
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   586
		]
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   587
	    ]
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   588
	]
85
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   589
    ].
143
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   590
!
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   591
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   592
selectedProcessesSend:aSelector
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   593
    self selectedProcessesDo:[:p |
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   594
	p perform:aSelector
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   595
    ].
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   596
    self updateView.
85
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   597
! !
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   598
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   599
!ProcessMonitor methodsFor:'queries'!
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   600
105
claus
parents: 100
diff changeset
   601
preferredExtent
85
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   602
    ^ (font widthOf:self titleLine) + 40 @ 100
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   603
! !