ProcessMonitor.st
author Claus Gittinger <cg@exept.de>
Thu, 28 Sep 1995 21:27:16 +0100
changeset 143 95c177bc7678
parent 138 b7d8b42d81db
child 144 31afc0d87819
permissions -rw-r--r--
*** empty log message ***
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
143
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
    17
                listUpdateBlock updateProcess hideDead runColor suspendedColor
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
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
"
143
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
    42
$Header: /cvs/stx/stx/libtool/ProcessMonitor.st,v 1.22 1995-09-28 20:27:16 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:[
143
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   168
        oldList := listView list.
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   169
        processes notNil ifTrue:[
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   170
            list := OrderedCollection new.
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   171
            list add:self titleLine.
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   172
            list add:(String new:self titleLine size withAll:$-).
85
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   173
143
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   174
            interrupted := Processor interruptedProcess.
85
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   175
143
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   176
            dIndex := 1.
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   177
            1 to:processes size do:[:index |
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   178
                |aProcess nm st c c0 n found|
85
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   179
143
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   180
                aProcess := processes at:index.
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   181
                aProcess notNil ifTrue:[
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   182
                    (aProcess id notNil or:[hideDead not]) ifTrue:[
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   183
                        line := aProcess id printStringPaddedTo:5.
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   184
                        (nm := aProcess name) isNil ifFalse:[
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   185
                            nm := nm printString
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   186
                        ] ifTrue:[
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   187
                            nm := ' '
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   188
                        ].
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   189
                        nm size >= 29 ifTrue:[
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   190
                            nm := (nm contractTo:28) , ' '
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   191
                        ] ifFalse:[
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   192
                            nm := (nm printStringPaddedTo:29).
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   193
                        ].
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
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
"/                        ].
143
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   201
                        st := aProcess state.
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   202
                        (st == #run
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   203
                         and:[aProcess == interrupted]) ifTrue:[
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   204
                            c := ' *'.
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   205
                        ] ifFalse:[
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   206
                            c := '  '.
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   207
                        ].
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   208
                        line := line , c , (st printStringPaddedTo:9).
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   209
                        line := line , (aProcess priority printStringLeftPaddedTo:3).
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   210
                        line := line , (aProcess usedStackSize printStringLeftPaddedTo:11).
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   211
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   212
                        n := aProcess numberOfStackSegments.
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   213
                        n == 0 ifTrue:[
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   214
                            con := nil
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   215
                        ] ifFalse:[
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   216
                            con := aProcess suspendedContext.
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   217
                            con isNil ifTrue:[
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   218
                                aProcess == Processor activeProcess ifTrue:[
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   219
                                    con := thisContext
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   220
                                ]
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   221
                            ]
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   222
                        ].
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   223
                        showDetail ifTrue:[
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   224
                            line := line , (aProcess totalStackSize printStringLeftPaddedTo:10).
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   225
                            line := line , '(' , n printString , ')'.
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   226
                            con notNil ifTrue:[
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   227
                                line := line , '    '.
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   228
                                line := line , ((ObjectMemory addressOf:con) printStringRadix:16).
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   229
                                line := line , ' .. '.
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   230
                                c := con.
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   231
                                [c sender notNil] whileTrue:[
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   232
                                    c := c sender
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   233
                                ].
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   234
                                line := line , ((ObjectMemory addressOf:c) printStringRadix:16).
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   235
                            ] ifFalse:[
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   236
                                line := line , (String new:20)
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   237
                            ].
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   238
                            line := line , ' '.
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   239
                            line := line , (aProcess numberOfStackBoundaryHits printStringLeftPaddedTo:5).
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   240
                        ].
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   241
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   242
                        con notNil ifTrue:[
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   243
                            "/ search for a semaphore-wait in the top 10 contexts
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   244
                            found := false.
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   245
                            c := con.
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   246
                            1 to:10 do:[:n |
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   247
                                found ifFalse:[
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   248
                                    c notNil ifTrue:[
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   249
                                        (c receiver isMemberOf:Semaphore) ifTrue:[
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   250
                                            c selector == #wait ifTrue:[
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   251
                                                found := true.
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   252
                                            ]
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   253
                                        ].
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   254
                                        c := c sender.
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   255
                                    ]
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   256
                                ]
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   257
                            ].
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   258
                            found ifFalse:[
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   259
                                c := con.
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   260
                                1 to:10 do:[:n |
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   261
                                    found ifFalse:[
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   262
                                        c notNil ifTrue:[
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   263
                                            (c receiver ~~ Processor) ifTrue:[
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   264
                                                found := true.
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   265
                                            ] ifFalse:[
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   266
                                                c := c sender.
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   267
                                            ]
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   268
                                        ]
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   269
                                    ]
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   270
                                ]
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   271
                            ].
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   272
                            found ifFalse:[
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   273
                                c := con
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   274
                            ].
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   275
                            [c isBlockContext] whileTrue:[
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   276
                                c := c home
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   277
                            ].
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   278
                            n := c receiver class name , '>>' , c selector.
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   279
                            line := line , '   ' , n
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   280
                        ].
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   281
                        list add:line.
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   282
                        processes at:dIndex put:aProcess.
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   283
                        dIndex := dIndex + 1
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   284
                    ]
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   285
                ].
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   286
            ].
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   287
            dIndex to:processes size do:[:index |
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   288
                processes at:index put:nil
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   289
            ]
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   290
        ].
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   291
        "avoid flicker"
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   292
        (oldList notNil and:[oldList size == list size]) ifTrue:[
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   293
            list keysAndValuesDo:[:idx :entry |
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   294
                (oldList at:idx) ~= entry ifTrue:[
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   295
                    listView at:idx put:entry
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   296
                ]
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   297
            ]
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   298
        ] ifFalse:[
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   299
            listView setList:list.
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   300
            "the first two entries cannot be selected"
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   301
            listView attributeAt:1 put:#disabled.
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   302
            listView attributeAt:2 put:#disabled.
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   303
        ]
85
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   304
    ].
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   305
    updateBlock notNil ifTrue:[
143
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   306
        Processor removeTimedBlock:updateBlock.
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   307
        Processor addTimedBlock:updateBlock afterSeconds:updateDelay
85
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   308
    ]
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   309
!
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   310
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   311
updateView
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   312
    self updateList.
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   313
    self updateStatus
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   314
! !
4cde336c0794 Initial revision
claus
parents:
diff changeset
   315
143
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   316
!ProcessMonitor methodsFor:'events'!
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   317
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   318
keyPress:key x:x y:y
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   319
    <resource: #keyboard ( #InspectIt ) >
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   320
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   321
    key == #InspectIt ifTrue:[
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   322
	^ self inspectProcess.
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   323
    ].
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   324
    ^ super keyPress:key x:x y:y
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
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   327
canHandle:key
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   328
    ^ key == #InspectIt
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   329
! !
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   330
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   331
!ProcessMonitor methodsFor:'initialization'!
4cde336c0794 Initial revision
claus
parents:
diff changeset
   332
4cde336c0794 Initial revision
claus
parents:
diff changeset
   333
initialize
107
claus
parents: 106
diff changeset
   334
    |v|
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   335
4cde336c0794 Initial revision
claus
parents:
diff changeset
   336
    super initialize.
4cde336c0794 Initial revision
claus
parents:
diff changeset
   337
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   338
    hideDead := true.
109
claus
parents: 107
diff changeset
   339
    showDetail := Smalltalk at:#SystemDebugging ifAbsent:false.
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   340
110
claus
parents: 109
diff changeset
   341
    v := HVScrollableView for:SelectionInListView miniScrollerH:true in:self.
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   342
    v origin:0.0@0.0 corner:1.0@1.0.
85
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   343
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   344
"/    self extent:(font widthOf:self titleLine) + v scrollBar width @ 100.
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   345
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   346
    listView := v scrolledView.
4cde336c0794 Initial revision
claus
parents:
diff changeset
   347
    listView font:font.
98
claus
parents: 97
diff changeset
   348
    listView menuHolder:self; menuPerformer:self; menuMessage:#processMenu. 
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   349
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   350
    listView multipleSelectOk:true.
97
claus
parents: 93
diff changeset
   351
    listView delegate:(KeyboardForwarder toView:self).
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   352
4cde336c0794 Initial revision
claus
parents:
diff changeset
   353
    updateDelay := 0.5.
4cde336c0794 Initial revision
claus
parents:
diff changeset
   354
    listUpdateDelay := 5.
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   355
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   356
    "/ true 
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   357
    ProcessorScheduler isPureEventDriven
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   358
    ifTrue:[
90
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   359
	updateBlock := [self updateStatus].
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   360
	listUpdateBlock := [self updateList].
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   361
    ].
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   362
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   363
    device hasColors ifTrue:[
90
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   364
	runColor := Color green.
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   365
	suspendedColor := Color yellow.
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   366
	waitColor := Color red.
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   367
    ] ifFalse:[
90
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   368
	runColor := suspendedColor := waitColor := Color black
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   369
    ]
4cde336c0794 Initial revision
claus
parents:
diff changeset
   370
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   371
    "
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   372
     ProcessMonitor open
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   373
    "
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   374
!
4cde336c0794 Initial revision
claus
parents:
diff changeset
   375
85
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   376
mapped
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   377
    super mapped.
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   378
    self updateStatus.
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   379
    self updateList.
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   380
!
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   381
93
claus
parents: 92
diff changeset
   382
startUpdateProcess
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   383
    updateBlock notNil ifTrue:[
90
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   384
	Processor addTimedBlock:updateBlock afterSeconds:updateDelay.
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   385
	Processor addTimedBlock:listUpdateBlock afterSeconds:listUpdateDelay.
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   386
    ] ifFalse:[
90
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   387
	updateProcess := [
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   388
	    Process terminateSignal handle:[:ex |
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   389
		updateProcess := nil
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   390
	    ] do:[
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   391
		|id cnt|
56
d0cb937cbcaa *** empty log message ***
claus
parents: 52
diff changeset
   392
90
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   393
		"
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   394
		 every 20ms, we look which process runs;
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   395
		 every half second, the status is updated.
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   396
		 every 5 seconds, the list of processes is
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   397
		 built up again
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   398
		"
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   399
		[true] whileTrue:[
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   400
		    1 to:9 do:[:i |
85
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   401
"/                        cpuUsages := IdentityDictionary new.
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   402
"/                        1 to:25 do:[:i |
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   403
"/                            (Delay forSeconds:0.02) wait.
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   404
"/                            id := Processor interruptedProcess id.
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   405
"/                            cnt := cpuUsages at:id ifAbsent:[0].
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   406
"/                            cpuUsages at:id put:cnt + 1.
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   407
"/                        ].
90
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   408
			(Delay forSeconds:0.5) wait.
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   409
			self updateStatus.
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   410
		    ].
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   411
		    (Delay forSeconds:0.5) wait.
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   412
		    self updateList.
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   413
		]
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   414
	    ]
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   415
	]  forkAt:(Processor userSchedulingPriority + 1).
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   416
	updateProcess name:'monitor [' , 
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   417
			   Processor activeProcess id printString ,
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   418
			   '] update'.
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   419
	"
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   420
	 raise my own priority
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   421
	"
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   422
	Processor activeProcess priority:(Processor userSchedulingPriority + 2)
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   423
    ].
93
claus
parents: 92
diff changeset
   424
!
claus
parents: 92
diff changeset
   425
claus
parents: 92
diff changeset
   426
realize
claus
parents: 92
diff changeset
   427
    super realize.
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   428
    waitColor := waitColor on:device.
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   429
    runColor := runColor on:device.
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   430
    suspendedColor := suspendedColor on:device.
93
claus
parents: 92
diff changeset
   431
claus
parents: 92
diff changeset
   432
    self startUpdateProcess.
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   433
! !
4cde336c0794 Initial revision
claus
parents:
diff changeset
   434
4cde336c0794 Initial revision
claus
parents:
diff changeset
   435
!ProcessMonitor methodsFor:'menu actions'!
4cde336c0794 Initial revision
claus
parents:
diff changeset
   436
85
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   437
processMenu
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   438
    |labels selectors m|
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   439
109
claus
parents: 107
diff changeset
   440
    device ctrlDown ifTrue:[
110
claus
parents: 109
diff changeset
   441
	labels := resources array:#(
109
claus
parents: 107
diff changeset
   442
			'\c detail'
claus
parents: 107
diff changeset
   443
		      ).
claus
parents: 107
diff changeset
   444
	selectors := #(
claus
parents: 107
diff changeset
   445
			detail
claus
parents: 107
diff changeset
   446
		      ).
claus
parents: 107
diff changeset
   447
    ] ifFalse:[
claus
parents: 107
diff changeset
   448
	labels := resources array:#(
claus
parents: 107
diff changeset
   449
			     'inspect' 
claus
parents: 107
diff changeset
   450
			     'debug'  
claus
parents: 107
diff changeset
   451
			     '-'  
claus
parents: 107
diff changeset
   452
			     'resume'  
claus
parents: 107
diff changeset
   453
			     'suspend'  
claus
parents: 107
diff changeset
   454
			     'stop'  
claus
parents: 107
diff changeset
   455
			     'abort'
claus
parents: 107
diff changeset
   456
			     'terminate'
claus
parents: 107
diff changeset
   457
			     '-'  
claus
parents: 107
diff changeset
   458
			     'raise prio'  
claus
parents: 107
diff changeset
   459
			     'lower prio'  
claus
parents: 107
diff changeset
   460
			    ).
claus
parents: 107
diff changeset
   461
	selectors := #(
claus
parents: 107
diff changeset
   462
			     inspectProcess  
claus
parents: 107
diff changeset
   463
			     debugProcess  
claus
parents: 107
diff changeset
   464
			     nil  
claus
parents: 107
diff changeset
   465
			     resumeProcess  
claus
parents: 107
diff changeset
   466
			     suspendProcess  
claus
parents: 107
diff changeset
   467
			     stopProcess  
claus
parents: 107
diff changeset
   468
			     abortProcess
claus
parents: 107
diff changeset
   469
			     terminateProcess
claus
parents: 107
diff changeset
   470
			     nil  
claus
parents: 107
diff changeset
   471
			     raisePrio
claus
parents: 107
diff changeset
   472
			     lowerPrio
claus
parents: 107
diff changeset
   473
			    ).
claus
parents: 107
diff changeset
   474
	updateProcess isNil ifTrue:[
claus
parents: 107
diff changeset
   475
	    labels := (resources array:#('update' '-')) , labels.
claus
parents: 107
diff changeset
   476
	    selectors := #(updateView nil) , selectors
claus
parents: 107
diff changeset
   477
	].
85
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   478
    ].
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   479
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   480
    m := PopUpMenu labels:labels
90
60d0bb749a1c *** empty log message ***
claus
parents: 85
diff changeset
   481
		   selectors:selectors.
85
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   482
109
claus
parents: 107
diff changeset
   483
    m checkToggleAt:#detail put:showDetail.
85
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   484
    ^ m
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   485
!
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   486
143
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   487
terminateProcess
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   488
    "terminate the selected process"
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   489
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   490
    self selectedProcessesSend:#terminate
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
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   493
hideDead:aBoolean
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   494
    hideDead := aBoolean
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   495
!
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   496
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   497
debugProcess
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   498
    "open a debugger on the selected process"
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   499
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   500
    self selectedProcessesDo:[:p |
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   501
       Debugger openOn:p
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   502
    ]
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   503
!
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
abortProcess
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   506
    "abort (raise AbortSignal in) the selected process"
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   507
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   508
    self selectedProcessesDo:[:p |
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   509
	p interruptWith:[AbortSignal raise]
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   510
    ]
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   511
!
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
inspectProcess
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   514
    "open an inspector on the selected process"
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   515
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   516
    self selectedProcessesSend:#inspect
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
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   519
detail
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   520
    showDetail := showDetail not.
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   521
    self updateView
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   522
!
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   523
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   524
resumeProcess
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   525
    "resume the selected process (i.e. let it run) "
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   526
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   527
    self selectedProcessesSend:#resume
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
92
claus
parents: 90
diff changeset
   530
stopProcess
claus
parents: 90
diff changeset
   531
    "stop the selected process - not even interrupts will wake it up"
claus
parents: 90
diff changeset
   532
claus
parents: 90
diff changeset
   533
    self selectedProcessesSend:#stop
claus
parents: 90
diff changeset
   534
!
claus
parents: 90
diff changeset
   535
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   536
suspendProcess
92
claus
parents: 90
diff changeset
   537
    "suspend the selected process - interrupts will let it run again"
claus
parents: 90
diff changeset
   538
58
43b7d463a7e5 *** empty log message ***
claus
parents: 57
diff changeset
   539
    self selectedProcessesSend:#suspend
85
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   540
!
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   541
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   542
raisePrio
92
claus
parents: 90
diff changeset
   543
    "raise the selected processes priority"
claus
parents: 90
diff changeset
   544
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   545
    self selectedProcessesDo:[:p |
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   546
       p priority:(p priority + 1)
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   547
    ]
85
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   548
!
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   549
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   550
lowerPrio
92
claus
parents: 90
diff changeset
   551
    "lower the selected processes priority"
claus
parents: 90
diff changeset
   552
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   553
    self selectedProcessesDo:[:p |
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   554
       p priority:(p priority - 1)
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   555
    ]
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   556
! !
4cde336c0794 Initial revision
claus
parents:
diff changeset
   557
143
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   558
!ProcessMonitor methodsFor:'private'!
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   559
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   560
selectedProcessesDo:aBlock
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   561
    |p nr sel|
85
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   562
143
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   563
    sel := listView selection.
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   564
    sel isNil ifTrue:[^ self].
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   565
    (sel isKindOf:Collection) ifTrue:[
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   566
	sel do:[:n |
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   567
	    nr := n - 2.   "for headlines"
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   568
	    nr notNil ifTrue:[
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   569
		nr > 0 ifTrue:[
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   570
		    p := processes at:nr.
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   571
		    p notNil ifTrue:[
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   572
		       aBlock value:p
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   573
		    ]
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   574
		]
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
	]
85
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   577
    ] ifFalse:[
143
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   578
	nr := sel - 2.     "for headlines"
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   579
	nr notNil ifTrue:[
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   580
	    nr > 0 ifTrue:[
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   581
		p := processes at:nr.
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   582
		p notNil ifTrue:[
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   583
		   aBlock value:p
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   584
		]
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   585
	    ]
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   586
	]
85
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   587
    ].
143
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   588
!
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   589
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   590
selectedProcessesSend:aSelector
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   591
    self selectedProcessesDo:[:p |
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   592
	p perform:aSelector
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   593
    ].
95c177bc7678 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 138
diff changeset
   594
    self updateView.
85
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   595
! !
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   596
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   597
!ProcessMonitor methodsFor:'queries'!
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   598
105
claus
parents: 100
diff changeset
   599
preferredExtent
85
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   600
    ^ (font widthOf:self titleLine) + 40 @ 100
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   601
! !
d9713a3ca092 *** empty log message ***
claus
parents: 58
diff changeset
   602