"
 COPYRIGHT (c) 1997 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:#ExternalStreamMonitor
	instanceVariableNames:'showTime streams filterOpenStreamsOnlyHolder
		filterPipesOnlyHolder filterSocketsOnlyHolder
		filterConnectedSocketsOnlyHolder'
	classVariableNames:''
	poolDictionaries:''
	category:'Monitors-ST/X'
!

!ExternalStreamMonitor class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1997 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 smalltalk's external stream instances - 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:]
        Stream ExternalStream
        WindowGroup
        ProcessMonitor
        SemaphoreMonitor OSProcessMonitor

    [author:]
        Claus Gittinger

    [start with:]
        ExternalStreamMonitor open
"
! !

!ExternalStreamMonitor class methodsFor:'defaults'!

defaultLabel
    ^ 'External Streams Monitor'

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

!ExternalStreamMonitor class methodsFor:'menu specs'!

filterMenu
    "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:#filterMenu
     (Menu new fromLiteralArrayEncoding:(ExternalStreamMonitor filterMenu)) startUp
    "

    <resource: #menu>

    ^ 
     #(Menu
        (
         (MenuItem
            label: 'Open Streams Only'
            indication: filterOpenStreamsOnlyHolder
            hideMenuOnActivated: false
          )
         (MenuItem
            label: '-'
          )
         (MenuItem
            label: 'Pipes Only'
            indication: filterPipesOnlyHolder
            hideMenuOnActivated: false
          )
         (MenuItem
            label: '-'
          )
         (MenuItem
            label: 'Sockets Only'
            indication: filterSocketsOnlyHolder
            hideMenuOnActivated: false
          )
         (MenuItem
            label: 'Connected Sockets Only'
            indication: filterConnectedSocketsOnlyHolder
            hideMenuOnActivated: false
          )
         )
        nil
        nil
      )
!

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:ExternalStreamMonitor andSelector:#mainMenu
     (Menu new fromLiteralArrayEncoding:(ExternalStreamMonitor mainMenu)) startUp
    "

    <resource: #menu>

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

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: 'Close'
            itemValue: menuCloseSelected
            enabled: hasSelection
          )
         (MenuItem
            label: '-'
          )
         (MenuItem
            label: 'Inspect'
            itemValue: inspectStream
            enabled: hasSelection
          )
         (MenuItem
            label: 'Debug Processes Blocked on It'
            itemValue: menuDebugProcessesBlockedOnIt
            enabled: hasSelection
          )
         (MenuItem
            label: 'References'
            itemValue: menuReferences
            enabled: hasSelection
          )
         )
        nil
        nil
      )
! !

!ExternalStreamMonitor methodsFor:'aspects'!

filterConnectedSocketsOnlyHolder
    filterConnectedSocketsOnlyHolder isNil ifTrue:[
        filterConnectedSocketsOnlyHolder := false asValue.
        filterConnectedSocketsOnlyHolder onChangeSend:#filterConnectedSocketsOnlyHolderChanged to:self.
    ].    
    ^ filterConnectedSocketsOnlyHolder
!

filterOpenStreamsOnlyHolder 
    filterOpenStreamsOnlyHolder isNil ifTrue:[
        filterOpenStreamsOnlyHolder := true asValue.
        filterOpenStreamsOnlyHolder onChangeSend:#filterOpenStreamsOnlyHolderChanged to:self.
    ].    
    ^ filterOpenStreamsOnlyHolder

    "Modified: / 29-10-2018 / 15:44:11 / Claus Gittinger"
!

filterPipesOnlyHolder
    filterPipesOnlyHolder isNil ifTrue:[
        filterPipesOnlyHolder := false asValue.
        filterPipesOnlyHolder onChangeSend:#filterPipesOnlyHolderChanged to:self.
    ].    
    ^ filterPipesOnlyHolder

    "Created: / 29-10-2018 / 15:36:07 / Claus Gittinger"
!

filterSocketsOnlyHolder
    filterSocketsOnlyHolder isNil ifTrue:[
        filterSocketsOnlyHolder := false asValue.
        filterSocketsOnlyHolder onChangeSend:#filterSocketsOnlyHolderChanged to:self.
    ].    
    ^ filterSocketsOnlyHolder
! !

!ExternalStreamMonitor methodsFor:'drawing'!

titleLine
    OperatingSystem isMSWINDOWSlike ifTrue:[
        ^ 'Type                           Global                          Handle Detail'.
    ] ifFalse:[    
        ^ 'Type                           Global                          FD Detail'.
    ].
    
    "
     ExternalStreamMonitor open
    "

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

updateList
    "update list of streams"

    |newList|

    shown ifTrue:[
        newList := ExternalStream allSubInstances.
        newList := newList reject:#isExecutor.
        
        self filterOpenStreamsOnlyHolder value ifTrue:[
            newList := newList select:[:eachStream | eachStream isOpen].
        ].

        self filterPipesOnlyHolder value ifTrue:[
            newList := newList select:[:eachStream | eachStream isPipeStream].
        ] ifFalse:[
            self filterSocketsOnlyHolder value ifTrue:[
                newList := newList select:[:eachStream | eachStream isSocket].
            ].
            self filterConnectedSocketsOnlyHolder value ifTrue:[
                newList := newList select:[:eachStream | eachStream isSocket and:[eachStream isConnected]].
            ].
        ].
        
        newList sort:[:s1 :s2 | 
                    s1 className < s2 className
                    or:[ s1 className = s2 className
                         and:[false]]
                ].

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

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

updateStatus:newStreamsList
    "update status display of streams"

    |numberOfHeadlines oldList list oldSelection newSelection|

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

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

            streams validElementsDo:[:aStream |
                |waiters waitersNames type globalNameOrNil handleString
                 isOpen handle detail color line|

                type := aStream className.
                "/ beware of aliases...
                aStream = Stdin ifTrue:[
                    globalNameOrNil := 'Stdin'.
                ] ifFalse:[
                    aStream = Stdout ifTrue:[
                        globalNameOrNil := 'Stdout'.
                    ] ifFalse:[
                        aStream = Stderr ifTrue:[
                            globalNameOrNil := 'Stderr'.
                        ] ifFalse:[
                            globalNameOrNil := Smalltalk keyAtValue:aStream.
                        ]
                    ]
                ].
                aStream isFileStream ifTrue:[
                    detail := aStream pathName.
                ] ifFalse:[
                    aStream isSocket ifTrue:[
                        detail := ''.
                        aStream getPeer notNil ifTrue:[
                            detail := detail,(aStream getPeerName printString),'[',(aStream getPeer printString),']'.
                        ].
                        aStream port notNil ifTrue:[
                            detail := detail,':',aStream port printString
                        ].
                        aStream isListening notNil ifTrue:[
                            detail := detail,' (listening)'
                        ].
                    ] ifFalse:[
                        aStream isPipeStream ifTrue:[
                            detail := aStream commandString.
                        ].    
                    ].
                ].
                
                OperatingSystem isMSWINDOWSlike ifTrue:[
                    aStream isOpen ifTrue:[
                        handle := aStream fileHandle.
                        handle isInteger ifTrue:[
                            handleString := handle printString
                        ] ifFalse:[
                            handleString := (handle address ? 0) hexPrintString
                        ].
                    ].
                    handleString := (handleString ? '') leftPaddedTo:7
                ] ifFalse:[
                    aStream isOpen ifTrue:[
                        [
                            handleString := aStream fileDescriptor printString
                        ] on:StreamError do:[
                        ].    
                    ].
                    handleString := (handleString ? '') leftPaddedTo:3
                ].

                line := (type contractTo:30) paddedTo:30.
                line := line , ' ' , (((globalNameOrNil ? '') contractTo:30) paddedTo:30).
                line := line , ' ' , handleString.
                line := line , ' ' , (detail ? '').

                isOpen := aStream isOpen.
                
"/                line := line
"/                          , ' '
"/                          , ((nm contractTo:25) paddedTo:25)
"/                          , ' '
"/                          , (count printStringLeftPaddedTo:3)
"/                          , ' '
"/                          , owner printString
"/                          , ' '
"/                          , (waiters size printStringLeftPaddedTo:3)
"/                          , ' '
"/                          , waitersNames.

                isOpen ifFalse:[
                    color := Color red.
                ] ifTrue:[
                    color := Color blue.
                ].
                line := line withColor:color.

                list add:line.
                oldSelection notNil ifTrue:[
                    (oldSelection includesIdentical:aStream) 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:lNr 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"
! !

!ExternalStreamMonitor methodsFor:'menu'!

selectedStreams
    "return all selected streams"

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

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

selectedStreamsDo:aBlock
    "evaluate aBlock on all selected streams"

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

statusMenu
    "return a popUpMenu"

    <resource: #programMenu>

    |labels selectors m|

    labels := resources array:#(
                         'Close'
                         '-'
                         'Inspect'
                         'Debug waiting Process(es)'
                         'References'
                        ).
    selectors := #(
                         menuCloseSelected
                         nil
                         inspectStream
                         menuDebugProcessesBlockedOnIt
                         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"
! !

!ExternalStreamMonitor methodsFor:'queries'!

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

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

!ExternalStreamMonitor methodsFor:'user actions'!

doubleClicked
    "open an inspector on the selected stream"

    self inspectStream

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

filterConnectedSocketsOnlyHolderChanged
    self filterConnectedSocketsOnlyHolder value ifTrue:[
        self filterPipesOnlyHolder value:false.
    ].        
    self sensor pushUserEvent:#updateList for:self

    "Modified: / 29-10-2018 / 15:48:44 / Claus Gittinger"
!

filterOpenStreamsOnlyHolderChanged
    self sensor pushUserEvent:#updateList for:self
!

filterPipesOnlyHolderChanged
    self filterPipesOnlyHolder value ifTrue:[
        self filterSocketsOnlyHolder value:false.
        self filterConnectedSocketsOnlyHolder value:false.
    ].        
    self sensor pushUserEvent:#updateList for:self

    "Created: / 29-10-2018 / 15:36:45 / Claus Gittinger"
!

filterSocketsOnlyHolderChanged
    self filterSocketsOnlyHolder value ifTrue:[
        self filterPipesOnlyHolder value:false.
    ].
    self sensor pushUserEvent:#updateList for:self

    "Modified: / 29-10-2018 / 15:48:40 / Claus Gittinger"
!

inspectStream
    "open an inspector on the selected stream(s)"

    self selectedStreamsDo:[:eachStream | eachStream inspect]

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

menuCloseSelected
    "close the selected stream(s)"

    self selectedStreamsDo:[:eachStream | eachStream close].
    self updateList.

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

menuDebugProcessesBlockedOnIt
    "open a debugger on processes which are blocked reding, writing or listening"

    self processesBlockedOnItDo:[:each | Debugger openOn:each].

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

menuInspectProcessesUsingIt
    "inspect processes which are blocked reding, writing or listening"

    self processesBlockedOnItDo:[:each | each inspect].

!

menuReferences
    "show references to the selected stream"

    ObjectMemory displayRefChainToAny:(self selectedStreams) limitNumberOfSearchedReferences:100.

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

processesBlockedOnIt
    "return processes which are blocked reding, writing or listening"

    |selected processes|

    processes := OrderedCollection new.
    selected := self selectedStreams.
    Process allInstancesDo:[:p |
        |con|

        p isDead ifFalse:[
            (con := p suspendedContext) notNil ifTrue:[
                 [con notNil and:[(selected includesIdentical:con receiver) not]] whileTrue:[
                    con := con sender.
                 ].
                 con notNil ifTrue:[
                    processes add:p.
                 ]
            ]
        ]
    ].
    ^  processes

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

processesBlockedOnItDo:aBlock
    "open a debugger on processes which are blocked reding, writing or listening"

    |processes|

    processes := self processesBlockedOnIt.
    processes notEmpty ifTrue:[
        processes do:[:each |
            aBlock value:each.
        ].
        ^ self
    ].
    Dialog information:'No process is blocked on '
                        ,(self selectedStreams size == 1 ifTrue:['this'] ifFalse:['any selected'])
                        ,' process'.

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

!ExternalStreamMonitor class methodsFor:'documentation'!

version
    ^ '$Header$'
!

version_CVS
    ^ '$Header$'
! !