"

 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:'semaphores 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.

    [see also:]

        Stream ExternalStream

        WindowGroup

        ProcessMonitor

        SemaphoreMonitor

    [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

          )

         (MenuItem

            label: '-'

          )

         (MenuItem

            label: 'Inspect'

            itemValue: inspectStream

          )

         (MenuItem

            label: 'Owners'

            itemValue: inspectOwners

          )

         )

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

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

    |oldList list oldSelection newSelection|

    shown ifTrue:[

        oldList := listView list.

        oldSelection := listView selection.

        oldSelection notNil ifTrue:[

            oldSelection := oldSelection 

                                collect:[:lineNr | 

                                    streams at:(lineNr - self numberOfHeadlines) ifAbsent:nil 

                                ].

            newSelection := OrderedCollection new.

        ].

        newStreamsList notNil ifTrue:[

            streams := WeakArray withAll:newStreamsList.

        ].

        streams notNil ifTrue:[

            list := OrderedCollection new:(streams size + self numberOfHeadlines).

            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|

"/                "/ need a copy - it may change while being enumerated

"/                [

"/                    count := aSemaphore count.

"/                    waiters := aSemaphore waitingProcesses copy.

"/                ] valueUninterruptably.

"/                str := '' writeStream.

"/                [

"/                    waiters notNil ifTrue:[

"/                        waiters do:[:aProcess |

"/                            str nextPut:$[.

"/                            aProcess id printOn:str.

"/                            str nextPutAll:' '''.

"/                            str nextPutAll:(aProcess name contractTo:40).

"/                            str nextPutAll:'''<'.

"/                            aProcess priority printOn:str.

"/                            str nextPutAll:'>]'.

"/                            str space.

"/                        ].

"/                    ]

"/                ] valueUninterruptably.

"/                waitersNames := str contents.

"/                (aSemaphore respondsTo:#name) ifTrue:[

"/                    nm := aSemaphore name.

"/                    nm isNil ifTrue:[

"/                        nm := ''

"/                    ]

"/                ] ifFalse:[

"/                    nm := ''

"/                ].

                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

                        ].

                    ] 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 colorizeAllWith: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 two entries cannot be selected"

            listView attributeAt:1 put:#disabled.

            listView attributeAt:2 put:#disabled.

        ].

        newSelection notNil ifTrue:[

            listView selectWithoutScroll:newSelection

        ].

        listView flush

    ].

    self installDelayedUpdate.

    "Modified: / 11-10-2017 / 13:56:14 / cg"

    "Modified: / 14-02-2019 / 15:44:09 / 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'

                         'References'

                        ).

    selectors := #(

                         menuCloseSelected