"
 COPYRIGHT (c) 2019 by Claus Gittinger
              All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"
"{ Package: 'stx:libtool' }"

"{ NameSpace: Smalltalk }"

SystemStatusMonitor subclass:#OSProcessMonitor
	instanceVariableNames:'processes showTime'
	classVariableNames:''
	poolDictionaries:''
	category:'Monitors-ST/X'
!

!OSProcessMonitor class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 2019 by Claus Gittinger
              All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"
!

documentation
"
    This view shows OS processes started by smalltalk - a debugging tool.

    [disclaimer:]
        this is based on one of the oldest tools in the system, written in the early 90's.
        It does in no way reflect the way GUIs are designed/written these days.
        However, after all those years, they are still very very useful (and not found in many other systems)  
        
    [see also:]
        OSProcess

    [author:]
        Claus Gittinger

    [start with:]
        OSProcessMonitor open
"
! !

!OSProcessMonitor class methodsFor:'defaults'!

defaultLabel
    ^ 'OS Process Monitor'

    "Created: 23.1.1997 / 02:52:53 / cg"
! !

!OSProcessMonitor class methodsFor:'menu specs'!

mainMenu
    "This resource specification was automatically generated
     by the MenuEditor of ST/X."

    "Do not manually edit this!! If it is corrupted,
     the MenuEditor may not be able to read the specification."


    "
     MenuEditor new openOnClass:OSProcessMonitor andSelector:#mainMenu
     (Menu new fromLiteralArrayEncoding:(OSProcessMonitor mainMenu)) startUp
    "

    <resource: #menu>

    ^ 
     #(Menu 
       (MenuItem
          label: 'File'
          submenuChannel: fileMenu
       ) 
       (MenuItem
          label: 'View'
          submenuChannel: viewMenu
       ) 
       (MenuItem
          label: 'Operations'
          submenuChannel: operationsMenu
       )
     )
!

operationsMenu
    "This resource specification was automatically generated
     by the MenuEditor of ST/X."

    "Do not manually edit this!! If it is corrupted,
     the MenuEditor may not be able to read the specification."


    "
     MenuEditor new openOnClass:ExternalStreamMonitor andSelector:#operationsMenu
     (Menu new fromLiteralArrayEncoding:(ExternalStreamMonitor operationsMenu)) startUp
    "

    <resource: #menu>

    ^ 
     #(Menu
        (
         (MenuItem
            label: 'Terminate'
            itemValue: menuTerminateSelected
          )
         (MenuItem
            label: '-'
          )
         (MenuItem
            label: 'Inspect'
            itemValue: inspectProcess
          )
         (MenuItem
            label: 'Owners'
            itemValue: inspectOwners
          )
         )
        nil
        nil
      )
! !

!OSProcessMonitor methodsFor:'drawing'!

titleLine
    "/ 123456789|12345|1234567890
    ^ 'PID    Status  Command                                              '.
    
    "
     OSProcessMonitor open
    "

    "Modified: / 17-06-1998 / 14:52:48 / cg"
    "Modified: / 29-10-2018 / 15:28:22 / Claus Gittinger"
!

updateList
    "update list of processes"

    |newList|

    shown ifTrue:[
        newList := OSProcess allSubInstances select:[:p | p pid notNil].
        newList sortBySelector:#pid.

        newList ~= processes ifTrue:[
            self updateStatus:newList
        ].
    ].
    self installDelayedUpdate.

    "Modified: / 29-10-2018 / 15:39:43 / Claus Gittinger"
!

updateStatus:newList
    "update status display of processes"

    |numberOfHeadlines oldList list oldSelection newSelection|

    shown ifTrue:[
        numberOfHeadlines := self numberOfHeadlines.

        oldList := listView list.
        oldSelection := listView selection.
        oldSelection notNil ifTrue:[
            oldSelection := oldSelection 
                                select:[:lineNr | lineNr > numberOfHeadlines]
                                thenCollect:[:lineNr | 
                                    processes at:(lineNr - numberOfHeadlines) ifAbsent:nil 
                                ].
            newSelection := OrderedCollection new.
        ].

        newList notNil ifTrue:[
            processes := WeakArray withAll:newList.
        ].
        processes notNil ifTrue:[
            list := OrderedCollection new:(processes size + numberOfHeadlines).
            showTime == true ifTrue:[
                list add:'Time: ',(Time now printString).
            ].
            list add:self titleLine.
            list add:(String new:(self titleLine size+20) withAll:$-).

            processes validElementsDo:[:process |
                |waiters waitersNames type globalNameOrNil handleString
                 isOpen handle detail color line status exitCode| 

                (status := process exitStatus) notNil ifTrue:[
                    exitCode := status code.
                ].

                line := (process pid printString) paddedTo:9.
                line := line , ' '.
                line := line , ((exitCode isNil ifTrue:[''] ifFalse:[exitCode printString]) paddedTo:4).
                line := line , ' '.
                line := line , (process commandString).

                process isAlive ifFalse:[
                    status success ifTrue:[
                        color := Color grey.
                    ] ifFalse:[
                        color := Color red.
                    ].
                    line := line withColor:color.
                ].

                list add:line.
                oldSelection notNil ifTrue:[
                    (oldSelection includesIdentical:process) ifTrue:[
                        newSelection add:list size.
                    ]
                ]
            ].
        ].
        "avoid flicker"
        (oldList notNil and:[oldList size == list size]) ifTrue:[
            list keysAndValuesDo:[:idx :entry |
                (oldList at:idx) ~= entry ifTrue:[
                    listView at:idx put:entry
                ]
            ]
        ] ifFalse:[
            listView setList:list.
            "the first few entries cannot be selected"
            1 to:numberOfHeadlines do:[:lNr |
                listView attributeAt:numberOfHeadlines put:#disabled.
            ].
        ].
        newSelection notNil ifTrue:[
            listView selectWithoutScroll:newSelection
        ].
        listView flush
    ].
    self installDelayedUpdate.

    "Modified: / 11-10-2017 / 13:56:14 / cg"
    "Modified: / 07-06-2019 / 22:10:36 / Claus Gittinger"
! !

!OSProcessMonitor methodsFor:'menu'!

selectedProcesses
    "return all selected streams"

    ^ Array streamContents:[:s |
        self selectedProcessesDo:[:each | s nextPut:each]
    ].

    "Created: / 29-10-2018 / 17:00:35 / Claus Gittinger"
!

selectedProcessesDo:aBlock
    "evaluate aBlock on all selected streams"

    self selectionIndicesDo:[:n |
        |nr process|
        
        nr := n - self numberOfHeadlines.
        nr notNil ifTrue:[
            nr > 0 ifTrue:[
                process := processes at:nr.
                (process notNil and:[process ~~ 0]) ifTrue:[
                   aBlock value:process
                ]
            ]
        ]
    ].
!

statusMenu
    "return a popUpMenu"

    <resource: #programMenu>

    |labels selectors m|

    labels := resources array:#(
                         'Terminate'
                         '-'
                         'Inspect'
                         'References'
                        ).
    selectors := #(
                         menuTerminateSelected
                         nil
                         inspectProcess
                         menuReferences
                        ).

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

    m := PopUpMenu labels:labels
                   selectors:selectors.


    listView hasSelection ifFalse:[
        m disableAll:#(
                         menuCloseSelected
                         inspectStream
                      )
    ].
    ^ m

    "Modified: / 18-08-2017 / 14:34:12 / cg"
! !

!OSProcessMonitor methodsFor:'queries'!

numberOfHeadlines
    ^ 2 + (showTime == true ifTrue:1 ifFalse:0)

    "Modified: / 29-10-2018 / 15:24:14 / Claus Gittinger"
! !

!OSProcessMonitor methodsFor:'user actions'!

doubleClicked
    "open an inspector on the selected process"

    self inspectProcess

    "Created: / 23-01-1997 / 03:22:04 / cg"
    "Modified: / 31-01-1997 / 22:33:27 / cg"
    "Modified (comment): / 07-04-2017 / 14:28:01 / cg"
!

inspectProcess
    "open an inspector on the selected process(es)"

    self selectedProcessesDo:[:eachProcess | eachProcess inspect]

    "Modified (format): / 07-04-2017 / 14:27:45 / cg"
!

menuReferences
    "show references to the selected processes"

    ObjectMemory 
        displayRefChainToAny:(self selectedProcesses) 
        limitNumberOfSearchedReferences:100.

    "Modified (format): / 07-04-2017 / 14:27:45 / cg"
    "Modified: / 29-10-2018 / 17:01:00 / Claus Gittinger"
!

menuTerminateSelected
    "close the selected stream(s)"

    self selectedProcessesDo:[:eachProcess | eachProcess terminate].
    self updateList.

    "Created: / 07-04-2017 / 14:26:04 / cg"
! !

!OSProcessMonitor class methodsFor:'documentation'!

version_CVS
    ^ '$Header$'
! !