8 be provided or otherwise made available to, or used by, any |
8 be provided or otherwise made available to, or used by, any |
9 other person. No title to or ownership of the software is |
9 other person. No title to or ownership of the software is |
10 hereby transferred. |
10 hereby transferred. |
11 " |
11 " |
12 |
12 |
13 SimpleView subclass:#ProcessMonitor |
13 STXStatusMonitor subclass:#ProcessMonitor |
14 instanceVariableNames:'listView processes listUpdateDelay updateDelay updateBlock |
14 instanceVariableNames:'processes hideDead runColor suspendedColor waitColor cpuUsages |
15 listUpdateBlock updateProcess hideDead runColor suspendedColor |
15 showDetail' |
16 waitColor cpuUsages showDetail' |
|
17 classVariableNames:'' |
16 classVariableNames:'' |
18 poolDictionaries:'' |
17 poolDictionaries:'' |
19 category:'Interface-Tools' |
18 category:'Interface-Tools' |
20 ! |
19 ! |
21 |
20 |
41 a popup menu for various useful operations on them. |
40 a popup menu for various useful operations on them. |
42 Especially 'debug' is useful, to see what a process is currently |
41 Especially 'debug' is useful, to see what a process is currently |
43 doing. |
42 doing. |
44 |
43 |
45 The information shown is: |
44 The information shown is: |
46 id - the numeric id of the process |
45 id - the numeric id of the process |
47 name - the name (if any) of the process |
46 name - the name (if any) of the process |
48 (the name has no semantic meaning; it exists for the processMonitor only) |
47 (the name has no semantic meaning; it exists for the processMonitor only) |
49 state - what is it doing; |
48 state - what is it doing; |
50 wait - waiting on a semaphore |
49 wait - waiting on a semaphore |
51 eventWait - waiting on a view-event semaphore |
50 eventWait - waiting on a view-event semaphore |
52 ioWait - waiting on an io-semaphore |
51 ioWait - waiting on an io-semaphore |
53 timeWait - waiting for a time-semaphore |
52 timeWait - waiting for a time-semaphore |
54 run - run, but currently not scheduled |
53 run - run, but currently not scheduled |
55 active - really running (this info is useless, since at |
54 active - really running (this info is useless, since at |
56 update time, its always the update process which is |
55 update time, its always the update process which is |
57 running) |
56 running) |
58 suspended - suspended; not waiting on a semaphore |
57 suspended - suspended; not waiting on a semaphore |
59 light - not yet started (i.e. has no stack yet) |
58 light - not yet started (i.e. has no stack yet) |
60 |
59 |
61 prio - the processes priority (1..30) |
60 prio - the processes priority (1..30) |
62 usedStack - the current stack use |
61 usedStack - the current stack use |
63 totalStack - the stack currently allocated (i.e. the maximum ever needed) |
62 totalStack - the stack currently allocated (i.e. the maximum ever needed) |
|
63 |
|
64 [see also:] |
|
65 Process ProcessorScheduler |
|
66 WindowGroup |
|
67 |
|
68 [author:] |
|
69 Claus Gittinger |
|
70 |
|
71 [start with:] |
|
72 ProcessMonitor open |
64 " |
73 " |
65 ! ! |
74 ! ! |
66 |
75 |
67 !ProcessMonitor class methodsFor:'defaults'! |
76 !ProcessMonitor class methodsFor:'defaults'! |
68 |
77 |
69 defaultIcon |
78 defaultIcon |
70 |i| |
79 |i| |
71 |
80 |
72 i := Image fromFile:'ProcMon.xbm'. |
81 i := Image fromFile:'ProcMon.xbm'. |
73 i notNil ifTrue:[^ i]. |
82 i notNil ifTrue:[^ i]. |
74 ^ StandardSystemView defaultIcon |
83 ^ super defaultIcon |
|
84 |
|
85 "Modified: 23.1.1997 / 02:52:31 / cg" |
75 ! |
86 ! |
76 |
87 |
77 defaultLabel |
88 defaultLabel |
78 ^ 'Process Monitor' |
89 ^ 'Process Monitor' |
79 ! ! |
|
80 |
|
81 !ProcessMonitor class methodsFor:'startup'! |
|
82 |
|
83 open |
|
84 |top monitor| |
|
85 |
|
86 top := StandardSystemView new. |
|
87 monitor := self origin:0.0@0.0 corner:1.0@1.0 in:top. |
|
88 top extent:monitor preferredExtent. |
|
89 top label:self defaultLabel. |
|
90 top icon:self defaultIcon. |
|
91 top open |
|
92 |
|
93 " |
|
94 ProcessMonitor open |
|
95 " |
|
96 ! ! |
|
97 |
|
98 !ProcessMonitor methodsFor:'destroying'! |
|
99 |
|
100 destroy |
|
101 updateBlock notNil ifTrue:[ |
|
102 Processor removeTimedBlock:updateBlock. |
|
103 Processor removeTimedBlock:listUpdateBlock. |
|
104 ] ifFalse:[ |
|
105 updateProcess notNil ifTrue:[updateProcess terminate] |
|
106 ]. |
|
107 super destroy |
|
108 ! ! |
90 ! ! |
109 |
91 |
110 !ProcessMonitor methodsFor:'drawing'! |
92 !ProcessMonitor methodsFor:'drawing'! |
111 |
93 |
112 titleLine |
94 titleLine |
336 Processor addTimedBlock:updateBlock afterSeconds:updateDelay |
318 Processor addTimedBlock:updateBlock afterSeconds:updateDelay |
337 ] |
319 ] |
338 |
320 |
339 "Modified: 3.7.1996 / 13:56:01 / stefan" |
321 "Modified: 3.7.1996 / 13:56:01 / stefan" |
340 "Modified: 18.7.1996 / 20:19:59 / cg" |
322 "Modified: 18.7.1996 / 20:19:59 / cg" |
341 ! |
|
342 |
|
343 updateView |
|
344 self updateList. |
|
345 self updateStatus |
|
346 ! ! |
323 ! ! |
347 |
324 |
348 !ProcessMonitor methodsFor:'events'! |
|
349 |
|
350 canHandle:key |
|
351 ^ key == #InspectIt |
|
352 ! |
|
353 |
|
354 keyPress:key x:x y:y |
|
355 <resource: #keyboard ( #InspectIt ) > |
|
356 |
|
357 key == #InspectIt ifTrue:[ |
|
358 ^ self inspectProcess. |
|
359 ]. |
|
360 ^ super keyPress:key x:x y:y |
|
361 ! ! |
|
362 |
|
363 !ProcessMonitor methodsFor:'initialization'! |
325 !ProcessMonitor methodsFor:'initialization'! |
364 |
326 |
365 initialize |
327 initialize |
366 |v| |
|
367 |
|
368 super initialize. |
328 super initialize. |
369 |
329 |
370 hideDead := true. |
330 hideDead := true. |
371 showDetail := Smalltalk at:#SystemDebugging ifAbsent:false. |
331 showDetail := Smalltalk at:#SystemDebugging ifAbsent:false. |
372 |
|
373 v := HVScrollableView for:SelectionInListView miniScrollerH:true in:self. |
|
374 v origin:0.0@0.0 corner:1.0@1.0. |
|
375 |
|
376 "/ self extent:(font widthOf:self titleLine) + v scrollBar width @ 100. |
|
377 |
|
378 listView := v scrolledView. |
|
379 listView font:font. |
|
380 listView menuHolder:self; menuPerformer:self; menuMessage:#processMenu. |
|
381 |
|
382 listView multipleSelectOk:true. |
|
383 listView delegate:(KeyboardForwarder toView:self). |
|
384 listView doubleClickAction:[:line | self debugProcess]. |
|
385 |
|
386 updateDelay := 0.5. |
|
387 listUpdateDelay := 5. |
|
388 |
|
389 "/ event mode is no longer used; |
|
390 "/ this event support may vanish |
|
391 Processor isPureEventDriven ifTrue:[ |
|
392 updateBlock := [self updateStatus]. |
|
393 listUpdateBlock := [self updateList]. |
|
394 ]. |
|
395 |
332 |
396 device hasColors ifTrue:[ |
333 device hasColors ifTrue:[ |
397 runColor := Color green. |
334 runColor := Color green. |
398 suspendedColor := Color yellow. |
335 suspendedColor := Color yellow. |
399 waitColor := Color red. |
336 waitColor := Color red. |
400 ] ifFalse:[ |
337 ] ifFalse:[ |
401 runColor := suspendedColor := waitColor := Color black |
338 runColor := suspendedColor := waitColor := Color black |
402 ] |
339 ]. |
403 |
340 |
404 " |
341 " |
405 ProcessMonitor open |
342 ProcessMonitor open |
406 " |
343 " |
407 |
344 |
408 "Modified: 13.4.1996 / 20:34:25 / cg" |
345 "Modified: 23.1.1997 / 02:51:38 / cg" |
409 ! |
|
410 |
|
411 mapped |
|
412 super mapped. |
|
413 self updateStatus. |
|
414 self updateList. |
|
415 ! |
346 ! |
416 |
347 |
417 realize |
348 realize |
418 super realize. |
|
419 waitColor := waitColor on:device. |
349 waitColor := waitColor on:device. |
420 runColor := runColor on:device. |
350 runColor := runColor on:device. |
421 suspendedColor := suspendedColor on:device. |
351 suspendedColor := suspendedColor on:device. |
422 |
352 super realize. |
423 self startUpdateProcess. |
353 |
424 ! |
354 "Modified: 23.1.1997 / 02:30:37 / cg" |
425 |
|
426 reinitialize |
|
427 updateProcess := nil. |
|
428 super reinitialize. |
|
429 self startUpdateProcess. |
|
430 |
|
431 "Created: 22.12.1995 / 22:48:37 / cg" |
|
432 "Modified: 22.12.1995 / 22:51:14 / cg" |
|
433 ! |
|
434 |
|
435 startUpdateProcess |
|
436 updateBlock notNil ifTrue:[ |
|
437 Processor addTimedBlock:updateBlock afterSeconds:updateDelay. |
|
438 Processor addTimedBlock:listUpdateBlock afterSeconds:listUpdateDelay. |
|
439 ] ifFalse:[ |
|
440 updateProcess := [ |
|
441 [ |
|
442 |id cnt| |
|
443 |
|
444 " |
|
445 every 20ms, we look which process runs; |
|
446 every half second, the status is updated. |
|
447 every 5 seconds, the list of processes is |
|
448 built up again |
|
449 " |
|
450 [true] whileTrue:[ |
|
451 1 to:9 do:[:i | |
|
452 "/ cpuUsages := IdentityDictionary new. |
|
453 "/ 1 to:25 do:[:i | |
|
454 "/ (Delay forSeconds:0.02) wait. |
|
455 "/ id := Processor interruptedProcess id. |
|
456 "/ cnt := cpuUsages at:id ifAbsent:[0]. |
|
457 "/ cpuUsages at:id put:cnt + 1. |
|
458 "/ ]. |
|
459 Delay waitForSeconds:0.5. |
|
460 self updateStatus. |
|
461 ]. |
|
462 Delay waitForSeconds:0.5. |
|
463 self updateList. |
|
464 ] |
|
465 ] valueOnUnwindDo:[ |
|
466 updateProcess := nil |
|
467 ] |
|
468 ] forkAt:(Processor userSchedulingPriority + 1). |
|
469 updateProcess name:'monitor [' , |
|
470 Processor activeProcess id printString , |
|
471 '] update'. |
|
472 " |
|
473 raise my own priority |
|
474 " |
|
475 Processor activeProcess priority:(Processor userSchedulingPriority + 2) |
|
476 ]. |
|
477 |
|
478 "Modified: 12.6.1996 / 19:53:13 / cg" |
|
479 ! ! |
355 ! ! |
480 |
356 |
481 !ProcessMonitor methodsFor:'menu actions'! |
357 !ProcessMonitor methodsFor:'menu actions'! |
482 |
358 |
483 abortProcess |
359 abortProcess |
494 self selectedProcessesDo:[:p | |
370 self selectedProcessesDo:[:p | |
495 Debugger openOn:p |
371 Debugger openOn:p |
496 ] |
372 ] |
497 ! |
373 ! |
498 |
374 |
499 detail |
|
500 showDetail := showDetail not. |
|
501 self updateView |
|
502 ! |
|
503 |
|
504 hideDead:aBoolean |
375 hideDead:aBoolean |
|
376 "turn on/off hiding of dead (already terminated) processes" |
|
377 |
505 hideDead := aBoolean |
378 hideDead := aBoolean |
506 ! |
379 |
507 |
380 "Modified: 23.1.1997 / 02:34:01 / cg" |
508 inspectProcess |
381 ! |
|
382 |
|
383 inspectSelection |
509 "open an inspector on the selected process" |
384 "open an inspector on the selected process" |
510 |
385 |
511 self selectedProcessesSend:#inspect |
386 self selectedProcessesSend:#inspect |
|
387 |
|
388 "Created: 23.1.1997 / 02:27:33 / cg" |
512 ! |
389 ! |
513 |
390 |
514 lowerPrio |
391 lowerPrio |
515 "lower the selected processes priority" |
392 "lower the selected processes priority" |
516 |
393 |
517 self selectedProcessesDo:[:p | |
394 self selectedProcessesDo:[:p | |
518 p priority:(p priority - 1) |
395 p priority:(p priority - 1) |
519 ] |
396 ] |
520 ! |
397 ! |
521 |
398 |
522 processMenu |
399 raisePrio |
|
400 "raise the selected processes priority" |
|
401 |
|
402 self selectedProcessesDo:[:p | |
|
403 p priority:(p priority + 1) |
|
404 ] |
|
405 ! |
|
406 |
|
407 restartProcess |
|
408 "abort (raise AbortSignal in) the selected process" |
|
409 |
|
410 self selectedProcessesDo:[:p | |
|
411 p restart. |
|
412 ] |
|
413 ! |
|
414 |
|
415 resumeProcess |
|
416 "resume the selected process (i.e. let it run) " |
|
417 |
|
418 self selectedProcessesSend:#resume |
|
419 ! |
|
420 |
|
421 statusMenu |
|
422 "return a popUpMenu" |
|
423 |
523 |labels selectors m sel allRestartable| |
424 |labels selectors m sel allRestartable| |
524 |
425 |
525 device ctrlDown ifTrue:[ |
426 device ctrlDown ifTrue:[ |
526 labels := resources array:#( |
427 labels := resources array:#( |
527 '\c detail' |
428 '\c detail' |
528 ). |
429 ). |
529 selectors := #( |
430 selectors := #( |
530 detail |
431 tiggleDetail |
531 ). |
432 ). |
532 ] ifFalse:[ |
433 ] ifFalse:[ |
533 labels := resources array:#( |
434 labels := resources array:#( |
534 'inspect' |
435 'inspect' |
535 'debug' |
436 'debug' |
596 allRestartable ifFalse:[ |
495 allRestartable ifFalse:[ |
597 m disable:#restartProcess |
496 m disable:#restartProcess |
598 ]. |
497 ]. |
599 ]. |
498 ]. |
600 |
499 |
601 m checkToggleAt:#detail put:showDetail. |
500 m checkToggleAt:#toggleDetail put:showDetail. |
602 ^ m |
501 ^ m |
603 ! |
502 |
604 |
503 "Created: 23.1.1997 / 03:05:54 / cg" |
605 raisePrio |
504 "Modified: 23.1.1997 / 03:10:09 / cg" |
606 "raise the selected processes priority" |
|
607 |
|
608 self selectedProcessesDo:[:p | |
|
609 p priority:(p priority + 1) |
|
610 ] |
|
611 ! |
|
612 |
|
613 restartProcess |
|
614 "abort (raise AbortSignal in) the selected process" |
|
615 |
|
616 self selectedProcessesDo:[:p | |
|
617 p restart. |
|
618 ] |
|
619 ! |
|
620 |
|
621 resumeProcess |
|
622 "resume the selected process (i.e. let it run) " |
|
623 |
|
624 self selectedProcessesSend:#resume |
|
625 ! |
505 ! |
626 |
506 |
627 stopProcess |
507 stopProcess |
628 "stop the selected process - not even interrupts will wake it up" |
508 "stop the selected process - not even interrupts will wake it up" |
629 |
509 |
644 |
524 |
645 terminateProcessGroup |
525 terminateProcessGroup |
646 "terminate the selected process with all of its subprocesses" |
526 "terminate the selected process with all of its subprocesses" |
647 |
527 |
648 self selectedProcessesSend:#terminateGroup |
528 self selectedProcessesSend:#terminateGroup |
|
529 ! |
|
530 |
|
531 toggleDetail |
|
532 "toggle detail" |
|
533 |
|
534 showDetail := showDetail not. |
|
535 self updateView |
|
536 |
|
537 "Modified: 23.1.1997 / 02:33:03 / cg" |
|
538 "Created: 23.1.1997 / 02:33:30 / cg" |
649 ! ! |
539 ! ! |
650 |
540 |
651 !ProcessMonitor methodsFor:'private'! |
541 !ProcessMonitor methodsFor:'private'! |
652 |
542 |
653 selectedProcessesDo:aBlock |
543 selectedProcessesDo:aBlock |
|
544 "evaluate aBlock on all selected processes" |
|
545 |
654 |p nr sel| |
546 |p nr sel| |
655 |
547 |
656 sel := listView selection. |
548 sel := listView selection. |
657 sel isNil ifTrue:[^ self]. |
549 sel isNil ifTrue:[^ self]. |
|
550 |
658 (sel isKindOf:Collection) ifTrue:[ |
551 (sel isKindOf:Collection) ifTrue:[ |
659 sel do:[:n | |
552 sel do:[:n | |
660 nr := n - 2. "for headlines" |
553 nr := n - 2. "for headlines" |
661 nr notNil ifTrue:[ |
554 nr notNil ifTrue:[ |
662 nr > 0 ifTrue:[ |
555 nr > 0 ifTrue:[ |
663 p := processes at:nr. |
556 p := processes at:nr. |
664 (p notNil and:[p ~~ 0]) ifTrue:[ |
557 (p notNil and:[p ~~ 0]) ifTrue:[ |
665 aBlock value:p |
558 aBlock value:p |
666 ] |
559 ] |
667 ] |
560 ] |
668 ] |
561 ] |
669 ] |
562 ] |
670 ] ifFalse:[ |
563 ] ifFalse:[ |
671 nr := sel - 2. "for headlines" |
564 nr := sel - 2. "for headlines" |
672 nr notNil ifTrue:[ |
565 nr notNil ifTrue:[ |
673 nr > 0 ifTrue:[ |
566 nr > 0 ifTrue:[ |
674 p := processes at:nr. |
567 p := processes at:nr. |
675 (p notNil and:[p ~~ 0]) ifTrue:[ |
568 (p notNil and:[p ~~ 0]) ifTrue:[ |
676 aBlock value:p |
569 aBlock value:p |
677 ] |
570 ] |
678 ] |
571 ] |
679 ] |
572 ] |
680 ]. |
573 ]. |
|
574 |
|
575 "Modified: 23.1.1997 / 03:10:53 / cg" |
681 ! |
576 ! |
682 |
577 |
683 selectedProcessesSend:aSelector |
578 selectedProcessesSend:aSelector |
|
579 "send a message to all selected processes" |
|
580 |
684 self selectedProcessesDo:[:p | |
581 self selectedProcessesDo:[:p | |
685 p perform:aSelector |
582 p perform:aSelector |
686 ]. |
583 ]. |
687 self updateView. |
584 self updateView. |
|
585 |
|
586 "Modified: 23.1.1997 / 02:34:49 / cg" |
688 ! ! |
587 ! ! |
689 |
588 |
690 !ProcessMonitor methodsFor:'queries'! |
589 !ProcessMonitor methodsFor:'user actions'! |
691 |
590 |
692 preferredExtent |
591 doubleClicked |
693 ^ (font widthOf:self titleLine) + 40 @ 100 |
592 "open a debugger on the selected process" |
|
593 |
|
594 self debugProcess |
|
595 |
|
596 "Created: 23.1.1997 / 03:21:30 / cg" |
694 ! ! |
597 ! ! |
695 |
598 |
696 !ProcessMonitor class methodsFor:'documentation'! |
599 !ProcessMonitor class methodsFor:'documentation'! |
697 |
600 |
698 version |
601 version |
699 ^ '$Header: /cvs/stx/stx/libtool/Attic/ProcMonitor.st,v 1.43 1996-10-28 20:13:31 cg Exp $'! ! |
602 ^ '$Header: /cvs/stx/stx/libtool/Attic/ProcMonitor.st,v 1.44 1997-01-23 02:23:09 cg Exp $'! ! |